#!/usr/local/bin/perl -w
use strict;
use utf8;

use Data::Dumper;
use JSON::XS;

use Getopt::Long;

my $cachepath = "/tmpfs/cache/";
my $filename;

my @d = localtime;
my $now_date = sprintf "%02d/%02d",$d[3],$d[4]+1;
my $now_date_s = sprintf "%04d%02d%02d",$d[5]+1900,$d[4],$d[3];
sub tf {
	my $tm = shift;
	my @t = localtime($tm);
	my $date = sprintf "%02d/%02d",$t[3],$t[4]+1;
	my $date_s = sprintf "%04d%02d%02d",$t[5]+1900,$t[4],$t[3];
	my $time = sprintf "%02d:%02d:%02d",@t[2,1,0];
	return
		sprintf "%10s %5s",
			$time,
			$date_s eq $now_date_s ? "" : $date;
}
sub make_cache {
	my ($name,%param) = @_;
	$param{raw_values} = 1;
	$param{empty_on_exit} = 0;
	$param{unlink_on_exit} = 0;
	$param{share_file} = $cachepath."/".$name;
	$param{init_file} = 0;
	$param{expire_time} ||= 0;
	unless(-e $param{share_file}){
		warn "no cache file $param{share_file}\n";
		return undef;
	}
	unless(-s $param{share_file} == $param{page_size} * $param{num_pages} ){
		warn "bad attr, diff size file $param{share_file}\n";
		warn "curr ",(-s $param{share_file})," need ",($param{page_size} * $param{num_pages}),"\n";
		return undef;
	}

	require Cache::FastMmap;
	my $cache = Cache::FastMmap->new(%param);
	return $cache;
}
sub big_int {
	my $str = shift;
	1 while $str=~s/(\d)(\d\d\d)(?!\d)/${1}_${2}/g;
	return $str;
}
sub find_caches {
	local *D;
	my %list;
	opendir D,$cachepath;
	while(my $f = readdir D){
		next if -d $cachepath."/".$f;
		next unless $f =~ /\.dat\b/;
		my $s = -s _;
		my $ps = 4*1024;
		my $np = int($s/$ps);
		while(!($np % 2) and $np*$ps <= $s){
			$ps *= 2;
			$np = int($s/$ps);
		}
		if($np*$ps == $s){
			$list{$f} = {
						page_size  => $ps,
						num_pages => $np,
					};
		}else{
			print $f," is bad size $s\n";
		}
	}
	closedir D;
	return %list;
}
my %all;

sub list_caches {
	my $total = 0;
	for my $k(sort {
			$all{$a}{page_size} * $all{$a}{num_pages}
			<=>
			$all{$b}{page_size} * $all{$b}{num_pages}
			} keys %all){
		my $v = $all{$k};
		printf "%-25s %13s (%s x %s)\n", $k,big_int($v->{page_size} * $v->{num_pages}),big_int($v->{page_size}),big_int($v->{num_pages});
		$total += $v->{page_size} * $v->{num_pages};
	}
	printf "%-25s %13s\n","TOTAL", big_int($total);
}
sub list_keys {
	my $file = shift;
	my $valid = shift;
	my $cache;
	unless($cache = $all{$file}){
		warn "no cache '$file'";
		return;
	}
	my $c = make_cache($file,%$cache);
	unless($c){
		return;
	}
	my @k = $c->get_keys(1);
	my $count = @k;
	unless($count){
		warn "cache '$file' is empty\n";
		return;
	}
	my @now = localtime;
	my $now = sprintf "%02d-%02d-%04d",
		$now[3],
		$now[4]+1,
		$now[5]+1900;
	my $max = 0;
	my $now_time = time;
	$max < length($_->{key}) and $max = length($_->{key}) for @k;	
	for my $kr(sort {$a->{key} cmp $b->{key}} @k){
		next if $valid and $kr->{expire_time} and $kr->{expire_time} < $now_time;
		my $key = $kr->{key};
		my @tm = localtime $kr->{last_access};
		my $date = sprintf "%02d-%02d-%04d",
			$tm[3],
			$tm[4]+1,
			$tm[5]+1900;
		my @tm2 = localtime($kr->{expire_time}||~1);
		my $date2 = sprintf "%02d-%02d-%04d",
			$tm2[3],
			$tm2[4]+1,
			$tm2[5]+1900;
		printf "%-${max}s %02d:%02d:%02d %10s %02d:%02d:%02d %10s%s\n",$key,
		$tm[2],
		$tm[1],
		$tm[0],
		($now eq $date?"":$date),
		$tm2[2],
		$tm2[1],
		$tm2[0],
		($now eq $date2?"":$date2),
		($kr->{expire_time} and $kr->{expire_time} < $now_time ? "*":"")
		;
	}
}
sub full_stat {
	my $need = shift;
	my @title_koef = (
		[0.1,"free"],[0.7,"small"],[1.4,"average"],[10,"high"],[10_000_000,"overload"],
		);
	my @koef = map {$_->[0]} @title_koef;
	for my $k(sort {
			$all{$a}{page_size} * $all{$a}{num_pages}
			<=>
			$all{$b}{page_size} * $all{$b}{num_pages}
			} grep{!$need or $need eq $_} keys %all){
		my $v = $all{$k};
		warn "count $k\n";
		my $c = make_cache($k,%$v);
		next unless $c;
		my @k = $c->get_keys(2);
		my $count = @k;
		unless($count){
			warn "cache is empty\n";
			next;
		}
		my $mkey = 0;
		my $mval = 0;
		my $tkey = 0;
		my $tval = 0;
		my $max_key = "";
		my $max_val = "";
		my @key_per_page = (0) x $v->{num_pages};
		my @size_per_page = (0) x $v->{num_pages};
		for(@k){
			my ($page,$slot) = $c->{Cache}->fc_hash($_->{key});
			my $k = length $_->{key};
			my $v = length $_->{value};
			$mkey = $k, $max_key = $_->{key} if $k > $mkey;
			$mval = $v, $max_val = $_->{key} if $v > $mval;
			$tkey += $k;
			$tval += $v;
			$key_per_page[$page]++;
			$size_per_page[$page] += $k+$v;
		}

		my $avg_key = $count / $v->{num_pages};
		my $avg_size = ($tval+$tkey) / $v->{num_pages};
		my @cnt_key = (0) x @koef;
		my @cnt_size = (0) x @koef;
		for (my $p = 0; $p < $v->{num_pages}; $p++){
			my $k_key = $key_per_page[$p] / $avg_key;
			my $k_size = $size_per_page[$p] / $avg_size;
			for(my $i = 0; $i < @koef; $i++){
				if($k_key < $koef[$i]){
					$cnt_key[$i]++;
					last;
				}
			}
			for(my $i = 0; $i < @koef; $i++){
				if($k_size < $koef[$i]){
					$cnt_size[$i]++;
					last;
				}
			}
		}


		print "-" x 10,"\n";
		print $k,"\n";
		print "\t","page_size: ",big_int($v->{page_size}),"\n";
		print "\t","num_pages: ",big_int($v->{num_pages}),"\n";
		print "\t","cache_size: ",big_int($v->{page_size} * $v->{num_pages}),"\n";
		print "\t","key_count: ",big_int($count),"\n";
		print "\t","max_key_size: ",$mkey," key: $max_key\n";
		print "\t","max_val_size: ",big_int($mval)," key: $max_val\n";
		print "\t","keys_size: ",big_int($tkey),"\n";
		print "\t","vals_size: ",big_int($tval),"\n";
		print "\t","used_size: ",big_int($tval+$tkey),"\n";
		print "\t","used: ",int(($tval+$tkey)/($v->{page_size} * $v->{num_pages})*1000)/10,"%\n";

		print "\taverage keys for page $avg_key\n";
		print "\taverage bytes for page $avg_size\n";
		printf "\t%16s %13s %13s\n","filling","keys","size";
		for(my $i = 0; $i < @koef; $i++){
			printf "\t%8s(%1s%5.0f%%) %5s(%5.1f%%) %5s(%5.1f%%)\n",
			$title_koef[$i][1],
			$title_koef[$i][0] < 100 ?("",($title_koef[$i][0]*100)) : (">",($title_koef[$i-1][0]*100)),
			$cnt_key[$i],$cnt_key[$i]/$v->{num_pages}*100,
			$cnt_size[$i],$cnt_size[$i]/$v->{num_pages}*100,
			;
		}

	}
}
sub dump_cache {
	my $file = shift;
	my $valid = shift;
	my $last = shift;
	my $expire = shift;
	my $cache;
	unless($cache = $all{$file}){
		warn "no cache '$file'";
		return;
	}
	my $c = make_cache($file,%$cache);
	unless($c){
		return;
	}
	my @k = $c->get_keys(2);
	my $count = @k;
	unless($count){
		warn "cache '$file' is empty\n";
		return;
	}
	my $max = 0;
	@k = sort {$a->{key} cmp $b->{key}} @k;
	$max < length($_->{key}) and $max = length($_->{key}) for @k;
	my $f = '%1s%-'.$max."s |".($expire?" %10s |":"")."".($last?" %10s |":"")." %s\n";
	my $now = time;
	require Compress::Zlib;
	for(@k){
		next if $valid and $_->{expire_time} and $_->{expire_time} < $now;
		if($_->{value} and substr($_->{value},0,2) eq "\037\213"){
			$_->{value} = Compress::Zlib::memGunzip($_->{value});
		}
		#if(my $m = Storable::read_magic($_->{value})){
		#	$_->{value} = Dumper(thaw($_->{value}));
		#}
		printf $f,
			($_->{expire_time} and $_->{expire_time} < $now) ? "*" : "",
			$_->{key},
			($expire?tf($_->{expire_time}||~1):()),
			($last?tf($_->{last_access}):()),
			$_->{value};
	}
}
sub clear_cache {
	my ($file) = @_;
	my $cache;
	unless($cache = $all{$file}){
		warn "no cache '$file'";
		return;
	}
	my $c = make_cache($file,%$cache);
	unless($c){
		return;
	}
	$c->clear;
}
sub get_value {
	my ($filename,$key,$thaw,$unzip) = @_;
	my $cache;
	unless($cache = $all{$filename}){
		warn "no cache '$filename'";
		return;
	}
	my $c = make_cache($filename,%$cache);
	unless($c){
		return;
	}
	my $val = $c->get($key);
	my $out;
	unless(defined $val){
		$out = "not found key($key)";
	}elsif($thaw){
		$out = "Found($key) length= ".length($val)."\n";
		if($unzip) {
			require Compress::Zlib;
			$val = Compress::Zlib::memGunzip($val);
			$out .= "length after unzip = ".length($val)."\n";
		}
		#$out .= Dumper(thaw($val));
		$out .= $val;
	}else{
		$out = "Found($key) length= ".length($val)."\n";
		$out .= $val;
	}
	print $out,"\n";
}
sub usage {
	warn "Option:",'
	--help|-?|-h - display this help
	--path|-p - path to caches
	--cache|-c - choose cache unless all caches
	--list|-l - display size of all caches
	--keys|-k - display keys in specified cache
	--full|-f - display full stats for specified cache of all
	--value|v - get value by key 
	--thaw|t - thawed getted value
	--unzip|u - Gunzip before thaw
	--valid - only valid key
	--clear - clearing cache
	--dump - dump cache
	--utf - use utf8 out
	--last - show last accesst
	--expire - show expire time
';
	#--dump|--dump-by-page|-d - dump specified cache page choosed by num or key ?(/^\d+$/)
	#--dump-by-key - dump specified cache page choosed by key

}
my $opt = {
	path => \$cachepath,
	cache => \$filename,
};
my $ret = GetOptions($opt,
		   'help|h|?',
		   'path|p:s',
		   'cache|c:s',
		   'list|l',
		   'keys|k',
		   'full|f',
		   'value|v:s@',
		   'thaw|t',
		   'unzip|u',
		   'clear',
		   'dump',
		   'utf',
		   'valid',
		   'last',
		   'expire',
		   );
if($opt->{utf}){
	binmode STDOUT,":utf8";
}
$cachepath =~ s|/$||;
%all = find_caches();
unless($ret){
	usage();
}elsif($opt->{help}){
	usage();
}elsif($opt->{list}){
	list_caches();
}elsif(defined $opt->{keys}){
	list_keys($filename,$opt->{valid});
}elsif(defined $opt->{full}){
	full_stat($filename);
}elsif(defined $opt->{clear}){
	clear_cache($filename);
}elsif(defined $opt->{dump}){
	dump_cache($filename,@{$opt}{'valid','last','expire'});
}elsif($opt->{value}){
	for my $key (@{$opt->{value}}){
		get_value($filename,$key,$opt->{thaw},$opt->{unzip});
	}
}else{
	usage();
}
